REM *** This program lets you experiment with producing various types REM *** of sounds, by variations in volume, duration, frequency and REM *** waveform. REM *** M. Meyers [71455,1472] DEFINT i,j,h DIM freq(28),frequency.v0(28),frequency.v1(28),wave0%(500),wave1%(500) DIM wavedef%(500) GOSUB initctrls FOR i=1 TO 28 : READ freq(i) frequency.v0(i)=freq(i) : frequency.v1(i)=freq(i) NEXT i DIM organ%(255) : RESTORE organ FOR i=0 TO 255 : READ organ%(i) : NEXT i GOSUB drawkeys FOR i=1 TO 28 : col=1 : GOSUB sounder : col=2 : GOSUB markkey : NEXT i PALETTE 3,0.8,0.6,0.53 '******** main loop *********** aloop: a$=INKEY$ GOSUB mouser ON MENU GOSUB menu.handeler IF a$=CHR$(139) THEN GOSUB helpmenu IF a$="" THEN GOTO aloop GOSUB keyhandeler GOTO aloop END '******** program routines ********** menu.handeler: menuid=MENU(0) menuitem=MENU(1) ' LOCATE 5,12:PRINT menuid;menuitem ' *** debug *** IF menuid=1 AND menuitem=1 THEN WAVE wvoice,SIN IF menuid=1 AND menuitem=2 THEN GOSUB newwave IF menuid=1 AND menuitem=3 THEN WAVE wvoice,organ% END IF IF menuid=2 AND menuitem=1 THEN MENU OFF: MENU RESET: CLS: STOP IF menuid=3 AND menuitem=1 THEN wvoice=0 : LOCATE 18,68 : PRINT wvoice; ELSEIF menuid=3 AND menuitem=2 THEN wvoice=1 : LOCATE 18,68 : PRINT wvoice; END IF RETURN initctrls: ' voice 1 LINE(50,10)-(200,30),2,b : LOCATE 5,10: PRINT "Volume v1"; LINE(250,10)-(400,30),2,b : LOCATE 5,37 : PRINT "Duration v1"; LINE(450,10)-(600,30),2,b : LOCATE 5,61 : PRINT "Frequency v1"; LINE(523,10)-(527,30),2,bf b=1:x=110:y=30:GOSUB volctrl.v1 ' set up initial volume b=1:x=270:y=30:GOSUB durctrl.v1 ' set up initial duration ' voice 0 LINE(50,40)-(200,60),2,b : LOCATE 9,10: PRINT "Volume v0"; LINE(250,40)-(400,60),2,b : LOCATE 9,37 : PRINT "Duration v0"; LINE(450,40)-(600,60),2,b : LOCATE 9,61 : PRINT "Frequency v0"; LINE(523,40)-(527,60),2,bf b=1:x=170:y=60:GOSUB volctrl.v0 ' set up initial volume b=1:x=270:y=60:GOSUB durctrl.v0 ' set up initial duration ' define keyboard LOCATE 14,15 : PRINT "Voice One"; LOCATE 20,15 : PRINT "Voice Zero"; ' waveform area wvoice=0:LOCATE 18,52 : PRINT "Active Voice is ";wvoice; MENU RESET MENU 1,0,1,"Waveform Menu" MENU 1,1,1,"Use Sin Waveform" MENU 1,2,1,"Create Custom Waveform" MENU 1,3,1,"Use Organ Waveform" MENU 2,0,1,"Program Execution" MENU 2,1,1,"Stop Program" MENU 3,0,1,"Waveform Voice Selection" MENU 3,1,1,"Voice 0" MENU 3,2,1,"Voice 1" MENU 4,0,1,"" MENU ON ' show how to get help LOCATE 14,50 : PRINT " Press HELP for help" LINE(463,100)-(510,115),1,b RETURN newwave: IF wvoice=0 THEN ERASE wave0% : DIM wave0%(500) IF wvoice=1 THEN ERASE wave1% : DIM wave1%(500) SCREEN 2,400,256,3,4 WINDOW 2,"Waveform Window",(100,50)-(600,150),0 WINDOW OUTPUT 2 LINE (250,0)-(250,100),2 LINE (0,50)-(500,50),2 WHILE b=0 b=MOUSE(0):x=MOUSE(1):y=MOUSE(2) WEND x1=x:y1=y:wvctr%=0:ix=x:iy=y newinit: b=MOUSE(0):x=MOUSE(1):y=MOUSE(2):actw=0 IF b<>0 THEN LINE(x1,y1)-(x,y),3 x1=x:y1=y IF y<51 THEN pw=127-(y*2.54) : actw=1 IF y>50 THEN mw=(y-50)*-2.54 : actw=2 : IF mw<-128 THEN mw=-128 IF mw>-3 THEN mw=0 IF (ix<>x OR iy<>y) AND b<>0 THEN wvctr%=wvctr%+1 IF actw=1 THEN IF wvoice=0 THEN wave0%(wvctr%)=pw IF wvoice=1 THEN wave1%(wvctr%)=pw END IF IF actw=2 THEN IF wvoice=0 THEN wave0%(wvctr%)=mw IF wvoice=1 THEN wave1%(wvctr%)=mw END IF 'LOCATE 5,5 : PRINT "mouser";b;x;y;pw;mw ' debug LOCATE 12,27 : PRINT "Points ="; : PRINT USING "#####";wvctr%; IF b<>0 AND x=0 AND y=0 THEN GOTO closeit ix=x:iy=y GOTO newinit: closeit: SCREEN CLOSE 2 WINDOW CLOSE 2 ERASE wavedef% : IF wvctr%>256 THEN DIM wavedef%(wvctr%) :ELSE DIM wavedef%(256) IF wvoice=0 THEN FOR i1=1 TO wvctr% wavedef%(i1)=wave0%(i1) NEXT i1 WAVE 0,wavedef% END IF IF wvoice=1 THEN FOR i1=1 TO wvctr% wavedef%(i1)=wave1%(i1) NEXT i1 WAVE 1,wavedef% END IF 'GOSUB check RETURN check: ' **** debug -- will display the waveforms **** LPRINT "wvoice =";wvoice FOR i=0 TO wvctr% : LPRINT wave0%(i); wave1%(i); wavedef%(i) : NEXT RETURN mouser: b=MOUSE(0):x=MOUSE(1):y=MOUSE(2) IF b<>0 AND x>49 AND x<201 AND y>9 AND y<31 THEN GOSUB volctrl.v1 IF b<>0 AND x>249 AND x<401 AND y>9 AND y<31 THEN GOSUB durctrl.v1 IF b<>0 AND x>449 AND x<601 AND y>9 AND y<31 THEN GOSUB freqctrl.v1 IF b<>0 AND x>49 AND x<201 AND y>39 AND y<61 THEN GOSUB volctrl.v0 IF b<>0 AND x>249 AND x<401 AND y>39 AND y<61 THEN GOSUB durctrl.v0 IF b<>0 AND x>449 AND x<601 AND y>39 AND y<61 THEN GOSUB freqctrl.v0 'LOCATE 20,50 : PRINT "mouser";b;x;y '*** debug *** RETURN freqctrl.v1: WHILE b<>0 AND x>451 AND x<599 AND y>9 AND y<31 IF x<523 THEN LINE (523,11)-(452,29),0,bf LINE (523,11)-(x,29),3,bf fm=x-450 : IF fm<1 THEN fm=1 fm=fm/70 : fm=1*fm : IF fm>1 THEN fm=1 END IF IF x>527 THEN LINE (527,11)-(599,29),0,bf LINE (527,11)-(x,29),3,bf fm=x-450 : IF fm<1 THEN fm=1 fm=fm/70 : fm=1.2*fm-0.375: IF fm<1 THEN fm=1 END IF b=MOUSE(0):x=MOUSE(1):y=MOUSE(2) 'LOCATE 1,63:PRINT USING "#.###";fm; ' debug WEND FOR j=1 TO 28 : frequency.v1(j)=freq(j)*fm : NEXT j RETURN freqctrl.v0: WHILE b<>0 AND x>451 AND x<599 AND y>39 AND y<61 IF x<523 THEN LINE (523,41)-(452,59),0,bf LINE (523,41)-(x,59),3,bf fm=x-450 : IF fm<1 THEN fm=1 fm=fm/70 : fm=1*fm : IF fm>1 THEN fm=1 END IF IF x>527 THEN LINE (527,41)-(599,59),0,bf LINE (527,41)-(x,59),3,bf fm=x-450 : IF fm<1 THEN fm=1 fm=fm/70 : fm=1.2*fm-0.375: IF fm<1 THEN fm=1 END IF b=MOUSE(0):x=MOUSE(1):y=MOUSE(2) 'LOCATE 10,63:PRINT USING "#.###";fm; ' debug WEND FOR j=1 TO 28 : frequency.v0(j)=freq(j)*fm : NEXT j RETURN durctrl.v1: WHILE b<>0 AND x>251 AND x<399 AND y>9 AND y<31 LINE (252,11)-(399,29),0,bf LINE (252,11)-(x,29),3,bf duration.v1=x-250 : IF duration.v1<1 THEN duration.v1=1 duration.v1=duration.v1/150 : duration.v1=24*duration.v1 b=MOUSE(0):x=MOUSE(1):y=MOUSE(2) 'LOCATE 1,39 : PRINT "d = ";duration.v1; ' debug WEND RETURN durctrl.v0: WHILE b<>0 AND x>251 AND x<399 AND y>39 AND y<61 LINE (252,41)-(399,59),0,bf LINE (252,41)-(x,59),3,bf duration.v0=x-250 : IF duration.v0<1 THEN duration.v0=1 duration.v0=duration.v0/150 : duration.v0=24*duration.v0 b=MOUSE(0):x=MOUSE(1):y=MOUSE(2) 'LOCATE 10,39 : PRINT "d = ";duration.v0; ' debug WEND RETURN volctrl.v1: WHILE b<>0 AND x>51 AND x<199 AND y>9 AND y<31 LINE (52,11)-(199,29),0,bf LINE (52,11)-(x,29),3,bf volume.v1=x-50 : IF volume.v1<1 THEN volume.v1=1 volume.v1=volume.v1/150 : volume.v1=255*volume.v1 b=MOUSE(0):x=MOUSE(1):y=MOUSE(2) 'LOCATE 1,12 : PRINT "v = ";volume.v1; ' debug WEND RETURN volctrl.v0: WHILE b<>0 AND x>51 AND x<199 AND y>39 AND y<61 LINE (52,41)-(199,59),0,bf LINE (52,41)-(x,59),3,bf volume.v0=x-50 : IF volume.v0<1 THEN volume.v0=1 volume.v0=volume.v0/150 : volume.v0=255*volume.v0 b=MOUSE(0):x=MOUSE(1):y=MOUSE(2) 'LOCATE 10,12 : PRINT "v = ";volume.v0; ' debug WEND RETURN sounder: 'SOUND WAIT IF i<15 THEN SOUND frequency.v0(i),duration.v0,volume.v0,0 IF i>14 THEN SOUND frequency.v1(i),duration.v1,volume.v1,1 'SOUND RESUME RETURN markkey: IF i<15 THEN y=125 CIRCLE(40+(18*i),y),5,col PAINT(40+(18*i),y),col,col END IF IF i>14 THEN y=75 CIRCLE(40+(18*(i-14)),y),5,col PAINT(40+(18*(i-14)),y),col,col END IF RETURN drawkeys: LINE(50,75)-(250,100),1,b FOR i=0 TO 250 STEP 18 LINE(50+i,75)-(50+i+15,100),1,bf NEXT i LINE(50,125)-(250,150),1,b FOR i=0 TO 250 STEP 18 LINE(50+i,125)-(50+i+15,150),1,bf NEXT i RETURN helpmenu: WINDOW 3,"Help Window",(50,20)-(600,180),8 WINDOW OUTPUT 3 PRINT "This program lets you experiment with creating different types of PRINT "sounds. Use the right mouse button to see and select from the PRINT "progam menus. PRINT PRINT "To change the volume, duration or frequency controls, move the PRINT "mouse within the desired box while holding down the left button. PRINT "If you select 'custom waveform' from the menu, use the mouse PRINT "(holding the left button down to draw) to draw the waveform you PRINT "want to use. Try to use more than 256 points, but less then 500. PRINT "To exit from the waveform screen, move the mouse pointer just to PRINT "left of the 'W' in 'Waveform' (outside the Waveform Window) and PRINT "press the left button. PRINT PRINT "Sounds are activated from the keyboard. Voice 1 is played with the PRINT "top row of keys (123...) while voice 0 is played with the 'ASDF...' PRINT "row plus then (,./) keys. Keep caps lock off! PRINT PRINT "Exit this menu by pressing the left mouse button b=0 WHILE b=0 b=MOUSE(0) WEND WINDOW CLOSE 3 RETURN frequencytable: DATA 130.81,146.83,164.81,174.61,196.00,220.00,246.94,261.63,293.66 DATA 329.63,349.23,392.00,440.00,493.88 DATA 523.25,587.33,659.26,701.00,783.99,880.00,993.00,1046.50,1174.70 DATA 1318.50,1396.90,1568.00,1760.00,1975.50 keyhandeler: IF a$="a" THEN i=1 :col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN IF a$="s" THEN i=2 :col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN IF a$="d" THEN i=3 :col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN IF a$="f" THEN i=4 :col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN IF a$="g" THEN i=5 :col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN IF a$="h" THEN i=6 :col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN IF a$="j" THEN i=7 :col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN IF a$="k" THEN i=8 :col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN IF a$="l" THEN i=9 :col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN IF a$=";" THEN i=10 :col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN IF a$="'" THEN i=11 :col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN IF a$="," THEN i=12 :col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN IF a$="." THEN i=13 :col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN IF a$="/" THEN i=14 :col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN IF a$="`" THEN i=15 :col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN IF a$="1" THEN i=16 :col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN IF a$="2" THEN i=17 :col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN IF a$="3" THEN i=18 :col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN IF a$="4" THEN i=19 :col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN IF a$="5" THEN i=20 :col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN IF a$="6" THEN i=21 :col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN IF a$="7" THEN i=22:col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN IF a$="8" THEN i=23:col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN IF a$="9" THEN i=24:col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN IF a$="0" THEN i=25:col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN IF a$="-" THEN i=26:col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN IF a$="=" THEN i=27:col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN IF a$="\" THEN i=28:col=1:GOSUB markkey:GOSUB sounder :col=2:GOSUB markkey: RETURN RETURN organ: DATA 0, 8, 15, 23, 30, 37, 44, 51, 57, 63, 69, 74, 79, 83, 87, 91 DATA 93, 96, 98, 99, 100, 100, 100, 99, 98, 97, 95, 92, 89, 86, 83, 79 DATA 75, 71, 66, 62, 57, 52, 48, 43, 39, 34, 30, 25, 21, 18, 14, 11 DATA 8, 5, 3, 0,-1,-3,-4,-5,-5,-6,-6,-5,-5,-4,-3,-1 DATA 0, 2, 3, 5, 7, 9, 11, 13, 15, 17, 18, 20, 21, 23, 24, 25 DATA 26, 26, 27, 27, 27, 27, 27, 26, 25, 24, 23, 22, 20, 18, 17, 15 DATA 13, 11, 9, 7, 5, 3, 1,-1,-3,-5,-6,-8,-9,-10,-11,-12 DATA -12,-13,-13,-13,-13,-13,-12,-11,-11,-10,-8,-7,-6,-4,-3,-2 DATA 0, 2, 3, 4, 6, 7, 8, 10, 11, 11, 12, 13, 13, 13, 13, 13 DATA 12, 12, 11, 10, 9, 8, 6, 5, 3, 1,-1,-3,-5,-7,-9,-11 DATA -13,-15,-17,-18,-20,-22,-23,-24,-25,-26,-27,-27,-27,-27,-27,-26 DATA -26,-25,-24,-23,-21,-20,-18,-17,-15,-13,-11,-9,-7,-5,-3,-2 DATA 0, 1, 3, 4, 5, 5, 6, 6, 5, 5, 4, 3, 1, 0,-3,-5 DATA -8,-11,-14,-18,-21,-25,-30,-34,-39,-43,-48,-52,-57,-62,-66,-71 DATA -75,-79,-83,-86,-89,-92,-95,-97,-98,-99,-100,-100,-100,-99,-98,-96 DATA -93,-91,-87,-83,-79,-74,-69,-63,-57,-51,-44,-37,-30,-23,-15,-8